home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / LIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  4.4 KB  |  159 lines
  1.  
  2. {$v-}
  3.  
  4. program _list; { LIST.PAS }
  5. { Simple (unfinished) list-program, by Bas van Gaalen }
  6. uses dos,u_txt,u_misc,u_kb;
  7.  
  8. type
  9.   lineptr=^linerec;
  10.   linerec=record
  11.     line:string;
  12.     next:lineptr;
  13.   end;
  14.  
  15. var
  16.   txtfile:text;
  17.   firstline,curline,lastline:lineptr;
  18.   search:string[50];
  19.   noflines:word;
  20.   ascii,clear:boolean;
  21.  
  22. {----------------------------------------------------------------------------}
  23.  
  24. procedure initialize;
  25. var fname:pathstr; hexcnt,total:longint; i:byte;
  26. begin
  27.   if paramstr(1)='' then begin
  28.     writeln('Enter filename on commandline'); halt; end;
  29.   fname:=paramstr(1);
  30.  
  31.   assign(txtfile,fname);
  32.   {$i-} reset(txtfile); {$i+}
  33.   if ioresult<>0 then begin
  34.     writeln('File not found...'); halt; end;
  35.  
  36.   hexcnt:=0;
  37.   total:=0;
  38.   noflines:=0;
  39.   new(firstline);
  40.   firstline^.next:=nil;
  41.   curline:=firstline;
  42.   repeat
  43.     readln(txtfile,curline^.line);
  44.     for i:=1 to length(curline^.line) do
  45.       if not (ord(curline^.line[i]) in [9..13,32..254]) then inc(hexcnt);
  46.     inc(total,length(curline^.line));
  47.     new(curline^.next);
  48.     curline:=curline^.next;
  49.     inc(noflines);
  50.   until eof(txtfile);
  51.   curline^.next:=nil;
  52.   lastline:=curline^.next;
  53.   ascii:=(hexcnt/total)<0.10;
  54.  
  55.   fillchar(search,sizeof(search),0);
  56.  
  57.   cursoroff;
  58. end;
  59.  
  60. {----------------------------------------------------------------------------}
  61.  
  62. procedure list;
  63. var scrpos:longint; key:word; stpos:integer; i:byte; escape:boolean;
  64.  
  65. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  66.  
  67. procedure dumpscreen(linenum:longint; start:integer);
  68. var tmp:string[80]; i:word; len:byte;
  69. begin
  70.   i:=0;
  71.   curline:=firstline;
  72.   while (i<>linenum) and (curline<>lastline) do begin
  73.     curline:=curline^.next; inc(i); end;
  74.   i:=1;
  75.   while (i<=rows) and (curline^.next<>lastline) do begin
  76.     fillchar(tmp,sizeof(tmp),#0);
  77.     if length(curline^.line)<start then len:=0
  78.     else if integer(length(curline^.line))-start>80 then len:=80
  79.     else len:=length(curline^.line)-start;
  80.     move(curline^.line[start+1],tmp[1],len);
  81.     tmp[0]:=#80;
  82.     dspat(tmp,0,i,lightgray);
  83.     curline:=curline^.next;
  84.     inc(i);
  85.   end;
  86.   if i<rows then filltext(' ',0,i,79,pred(rows),lightgray);
  87. end;
  88.  
  89. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  90.  
  91. procedure find(var linenum:longint; var start:integer; searchstart:word);
  92. var i:word; found:boolean;
  93. begin
  94.   if searchstart=0 then begin
  95.     filltext(' ',0,0,79,0,_lightgray);
  96.     dspat('Search: ',1,0,_lightgray);
  97.     i:=input(9,0,search,[#31..#126],30,_lightgray+blue,_lightgray,nocap,pos_le);
  98.   end;
  99.   curline:=firstline; i:=0;
  100.   while (i<>searchstart) and (curline<>lastline) do begin
  101.     curline:=curline^.next; inc(i); end;
  102.   found:=false;
  103.   while (not found) and (curline<>lastline) do begin
  104.     found:=pos(strup(search),strup(curline^.line))<>0;
  105.     if not found then begin
  106.       curline:=curline^.next; inc(i); end;
  107.   end;
  108.   if found then begin
  109.     linenum:=I; start:=0; end
  110.   else begin
  111.     filltext(' ',0,0,79,0,_lightgray);
  112.     dspat('* Not Found *',1,0,_lightgray+blue);
  113.     clear:=false;
  114.   end;
  115. end;
  116.  
  117. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  118.  
  119. begin
  120.   clrscr;
  121.   scrpos:=0; stpos:=0; escape:=false; clear:=true;
  122.   repeat
  123.     dumpscreen(scrpos,stpos);
  124.     if clear then begin
  125.       filltext(' ',0,0,79,0,_lightgray);
  126.       if ascii then dspat('ASCII',59,0,_lightgray)
  127.       else dspat('HEX  ',59,0,_lightgray);
  128.       dspat(lz(succ(scrpos),3)+'/'+lz(succ(noflines),3),66,0,_lightgray);
  129.       dspat(lz(stpos,3),74,0,_lightgray);
  130.     end;
  131.     clear:=true;
  132.     key:=getekey;
  133.     case key of
  134.       crsrup:if scrpos>0 then dec(scrpos);
  135.       crsrdown:if scrpos<noflines then inc(scrpos);
  136.       crsrpgup:if scrpos-rows>=0 then dec(scrpos,rows) else scrpos:=0;
  137.       crsrpgdn:if scrpos<=noflines-rows then inc(scrpos,rows);
  138.       crsrhome:scrpos:=0;
  139.       crsrend:scrpos:=noflines-rows+1;
  140.       crsrright:if stpos+10<=210 then inc(stpos,10);
  141.       crsrleft:if stpos-10>=0 then dec(stpos,10);
  142.       crsrcend:stpos:=210;
  143.       crsrhome:stpos:=0;
  144.       crsresc:escape:=true;
  145.       ord('F'),ord('f'):find(scrpos,stpos,0);
  146.       ord('N'),ord('n'):find(scrpos,stpos,succ(scrpos));
  147.     end;
  148.   until escape;
  149.   clrscr;
  150.   cursoron;
  151. end;
  152.  
  153. {----------------------------------------------------------------------------}
  154.  
  155. begin
  156.   initialize;
  157.   list;
  158. end.
  159.